home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dosver1r / starfiel.bas < prev    next >
Encoding:
BASIC Source File  |  1999-04-23  |  4.6 KB  |  127 lines
  1. Attribute VB_Name = "Starfields"
  2.  
  3. Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  4. Const WarpStarSpeed = 100
  5. Type Stars
  6.     SpeedY As Integer
  7.     SpeedX As Integer
  8.     StarX As Integer
  9.     StarY As Integer
  10.     StarColor As Byte
  11. End Type
  12. Public SpecialEffectX As Integer
  13. Public SpecialEffectY As Integer
  14. Public Star() As Stars 'Array of Stars Type
  15. Public StarCount As Integer ' holds the amount of stars in array
  16. Public Status As String 'holds Name of the current effect
  17.  
  18. Sub ReDimStars(HowManyStars As Integer)
  19. 'call this to reset the amount of stars, MAX = 32,767
  20.   StarCount = HowManyStars
  21.   ReDim Star(0 To HowManyStars)
  22. End Sub
  23.  
  24.  
  25. Sub AddStars(NumberToAdd As Integer, WhatHeight As Integer, WhatWidth As Integer)
  26. 'call this to add more stars, MAX = 32,767
  27.   Dim NewAmount As Integer, Starloop As Integer
  28.   NewAmount = StarCount + NumberToAdd
  29.   ReDim Preserve Star(0 To NewAmount)
  30.   Select Case Status
  31.     Case "Snow"
  32.       For Starloop = StarCount To NewAmount
  33.         Star(Starloop).StarX = 0
  34.         Star(Starloop).StarX = Int(Rnd * WhatWidth)
  35.         Star(Starloop).StarColor = 15
  36.         Star(Starloop).SpeedY = Int(Rnd * 3) + 1
  37.       Next Starloop
  38.       StarCount = NewAmount
  39.   End Select
  40. End Sub
  41. Sub StarSetup(WhatHeight As Integer, WhatWidth As Integer)
  42.   Dim i As Integer, j As Integer
  43.   If StarCount = Null Or StarCount = 0 Then Exit Sub
  44.   Select Case Status
  45.         
  46.   Case "Snow"
  47.     For i = 0 To StarCount
  48.       Star(i).StarColor = 15
  49.       Star(i).StarX = Int(Rnd * WhatWidth)
  50.       Star(i).StarY = Int(Rnd * WhatHeight)
  51.       Star(i).SpeedY = Int(Rnd * 3) + 1
  52.     Next i
  53.   Case "Stars"
  54.     For i = 0 To StarCount
  55.       Star(i).StarColor = Int(Rnd * 15) + 1
  56.       Star(i).StarX = Int(Rnd * WhatWidth)
  57.       Star(i).StarY = Int(Rnd * WhatHeight)
  58.       Star(i).SpeedY = Int(Rnd * 7) + 1
  59.     Next i
  60.             
  61.   Case "Black Hole"
  62.     For i = 0 To StarCount
  63.       Star(i).StarColor = Int(Rnd * 15) + 1
  64.       Star(i).StarX = Int(WhatWidth / 2)
  65.       Star(i).StarY = Int(WhatHeight / 2)
  66.       Star(i).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  67.       Star(i).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  68.       Do While Star(i).SpeedX = 0 Or Star(i).SpeedY = 0
  69.         Randomize
  70.         Star(i).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  71.         Star(i).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  72.       Loop
  73.       For j = 0 To 30
  74.         NextStarPosition i, WhatWidth, WhatHeight
  75.       Next j
  76.       Next i
  77.   End Select
  78. End Sub
  79.  
  80.  
  81. Sub NextStarPosition(StarNumber As Integer, WhatHeight As Integer, WhatWidth As Integer)
  82.  
  83.   Select Case Status
  84.  
  85.     Case "Snow"
  86.       Star(StarNumber).StarY = Star(StarNumber).StarY + Star(StarNumber).SpeedY
  87.       Star(StarNumber).StarX = Star(StarNumber).StarX + Int(5 * Rnd) - 2
  88.       If Star(StarNumber).StarX > WhatWidth Then Star(StarNumber).StarX = 0
  89.       If Star(StarNumber).StarX < 0 Then Star(StarNumber).StarX = WhatWidth
  90.       If Star(StarNumber).StarY > WhatHeight Then
  91.         Star(StarNumber).SpeedY = Int(2 * Rnd) + 1
  92.         Star(StarNumber).StarY = Star(StarNumber).SpeedY
  93.         Star(StarNumber).StarColor = 15
  94.       End If
  95.     
  96.     Case "Stars"
  97.       Star(StarNumber).StarY = Star(StarNumber).StarY + Star(StarNumber).SpeedY
  98.       If Star(StarNumber).StarY > WhatHeight Then
  99.         Star(StarNumber).SpeedY = Int(7 * Rnd) + 2
  100.         Star(StarNumber).StarY = Star(StarNumber).SpeedY
  101.         Star(StarNumber).StarColor = Int(Rnd * 15) + 1
  102.       End If
  103.  
  104.     Case "Black Hole"
  105.       If Star(StarNumber).StarY > WhatHeight Or Star(StarNumber).StarX > WhatWidth Or Star(StarNumber).StarY < 0 Or Star(StarNumber).StarX < 0 Then
  106.         Star(StarNumber).StarX = SpecialEffectX 'Int(WhatWidth / 2) + SpecialEffectX
  107.         Star(StarNumber).StarY = SpecialEffectY 'Int(WhatHeight / 2) + SpecialEffectY
  108.         Randomize
  109.         Star(StarNumber).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  110.         Star(StarNumber).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  111.         Do While (Star(StarNumber).SpeedX = Star(StarNumber).SpeedY Or Star(StarNumber).SpeedX = 0 Or Star(StarNumber).SpeedY = 0)
  112.           Randomize
  113.           Star(StarNumber).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  114.           Star(StarNumber).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
  115.         Loop
  116.       End If
  117.       
  118.       Star(StarNumber).StarY = Star(StarNumber).StarY + (Star(StarNumber).SpeedY)
  119.       Star(StarNumber).StarX = Star(StarNumber).StarX + (Star(StarNumber).SpeedX)
  120.     End Select
  121.     
  122.     
  123. End Sub
  124.  
  125.  
  126.  
  127.